home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 015a / qbfree71.zip / FREE71.BAS next >
BASIC Source File  |  1991-02-16  |  6KB  |  172 lines
  1.  
  2.   ' Free71.Bas  02-16-91   Multi-drive free disk space utility.
  3.   ' Copyright 1991 by Thomas E. McCormick. All rights reserved.
  4.   ' Placed into the public domain by the author.
  5.   ' Source may be used in part or in total without restriction.
  6.   ' Requires Crescent Software QuickPak Professional Library.
  7.   ' Uses InterruptX under Microsoft BASIC 7.1 PDS:...QBX.LIB.
  8.   ' Reports media data, total space, and free disk space on
  9.   ' 1 or more drives by displaying one line per drive.  The
  10.   ' drive(s) specifier may or may not have colons or spaces.
  11.   ' Traps/reports drive not ready, invalid drive letter, etc..
  12.   ' -------------------------------------------------------------
  13.   ' Compile and Link example batch file:
  14.   ' @Echo OFF
  15.   ' Rem ClFree71.Bat  02-16-91  TEM   (C)ompile and (L)ink Free71.Bas
  16.   ' bc free71 /o/s;
  17.   ' link /noe/seg:400 free71+nofltin+nocom+nograph+nolpt+noedit+smallerr,,nul,qbx+d:\bc7\pro\libs7\pro7;
  18.   ' -------------------------------------------------------------
  19.   ' Example: To see free space on drives C:, D:, and E:, enter:
  20.   '          free cde
  21.   '      or  free c d e
  22.   '      or  free c:d:e:
  23.   '      or  free c: d: e:
  24.   ' The output may be redirected.
  25.   ' -------------------------------------------------------------
  26.  
  27.   '----- QuickPAK declarations: let compiler syntax for you...
  28.   DECLARE FUNCTION DiskRoom& (Q.Drive$)
  29.   DECLARE FUNCTION DiskSize& (Q.Drive$)
  30.   DECLARE FUNCTION DOSError ()
  31.   DECLARE FUNCTION GetDrive% ()
  32.   DECLARE FUNCTION ReadTest% (Q.Drive$)
  33.  
  34.   DECLARE SUB BPrint (Lin$)
  35.  
  36.  
  37.   '----- Define the type needed for InterruptX -----
  38.   TYPE RegTypeX
  39.      ax    AS INTEGER
  40.      bx    AS INTEGER
  41.      cx    AS INTEGER
  42.      dx    AS INTEGER
  43.      bp    AS INTEGER
  44.      si    AS INTEGER
  45.      di    AS INTEGER
  46.      flags AS INTEGER
  47.      ds    AS INTEGER
  48.      es    AS INTEGER
  49.   END TYPE
  50.   DECLARE SUB InterruptX (intnum AS INTEGER,inreg AS RegTypeX, outreg AS RegTypeX)
  51.   DIM regs AS RegTypeX
  52.  
  53.  
  54. Begin:
  55.    DriveList$ = COMMAND$
  56.    IF DriveList$ = "" THEN
  57.       DriveList$ = CHR$(GetDrive%)         'Get default drive letter
  58.    END IF
  59.    Clen% = LEN(DriveList$)
  60.  
  61. DoCmdTail:
  62.    FOR DriveLetters% = 1 TO Clen%          'Drive(s) were specified
  63.      C$ = MID$(DriveList$, DriveLetters%, 1) 'COMMAND$ is upper case
  64.      Drive% = INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", C$)
  65.      IF Drive% > 0 THEN                'Skip colons, spaces, etc
  66.         Q.Drive$ = C$              'The drive letter uppercase
  67.                 DriveReady% = ReadTest%(Q.Drive$)
  68.                     IF NOT DriveReady% THEN   'Invalid, door open, etc.
  69.                        DriveDesc$ = "????? "  'Report it anyway
  70.                        GOSUB Q.ReportDiskInfo
  71.                        GOTO NextDrive
  72.                     END IF
  73.                 Q.FreeSpace& = DiskRoom&(Q.Drive$)
  74.                 Q.TotalSpace& = DiskSize&(Q.Drive$)
  75.                 IF Q.TotalSpace& > 10000 THEN 'Prevent divide by zero
  76.                     Temp& = (Q.FreeSpace& * 100)
  77.                     Q.FreePct& = (Temp& \ Q.TotalSpace&)
  78.                 END IF
  79.         GOSUB Q.GetMediaType       'For specific desc comment
  80.         GOSUB Q.ReportDiskInfo     'Output 1 line per drive
  81.      END IF
  82. NextDrive:
  83.    NEXT DriveLetters%
  84.    SYSTEM
  85.   '------
  86.  
  87. Q.GetMediaType:                            'get disk ID byte
  88.     regs.ax = &H1C00
  89.     regs.dx = ASC(Q.Drive$) - 64       'A=0, B=1, etc.
  90. 30  CALL InterruptX(&H21, regs, regs)      'Uses QBX.LIB
  91. 31  DEF SEG = regs.ds
  92.     Q.MediaIDByte% = PEEK(regs.bx)
  93.     DEF SEG
  94.     DriveDesc$ = "               "     'In case unidentified
  95.    SELECT CASE Q.MediaIDByte%
  96.    CASE &HF0
  97.       IF Q.TotalSpace& > 1300000 THEN
  98.          DriveDesc$ = "3" + CHR$(171) + " HD " + Dk$
  99.       END IF
  100.       IF Q.TotalSpace& > 2500000 THEN
  101.          DriveDesc$ = "3" + CHR$(171) + " XD " + Dk$
  102.       END IF
  103.    CASE &HF8
  104.       DriveDesc$ = "Fixed "
  105.    CASE &HF9
  106.       IF Q.TotalSpace& > 150000 THEN
  107.          DriveDesc$ = "5" + CHR$(172) + " SS " + Dk$
  108.       END IF
  109.       IF Q.TotalSpace& > 170000 THEN
  110.          DriveDesc$ = "5" + CHR$(172) + " SS " + Dk$
  111.       END IF
  112.       IF Q.TotalSpace& > 300000 THEN
  113.          DriveDesc$ = "5" + CHR$(172) + " SD " + Dk$
  114.       END IF
  115.       IF Q.TotalSpace& > 340000 THEN
  116.          DriveDesc$ = "5" + CHR$(172) + " SD " + Dk$
  117.       END IF
  118.       IF Q.TotalSpace& > 700000 THEN
  119.          DriveDesc$ = "3" + CHR$(171) + " DD " + Dk$
  120.       END IF
  121.       IF Q.TotalSpace& > 900000 THEN
  122.          DriveDesc$ = "5" + CHR$(172) + " HD " + Dk$
  123.       END IF
  124.    CASE &HFD
  125.          DriveDesc$ = "5" + CHR$(172) + " SD " + Dk$
  126.    CASE ELSE
  127.    END SELECT
  128.  
  129.    RETURN
  130.   '------
  131.  
  132. Q.ReportDiskInfo:
  133.    Lin$ = DriveDesc$ + "Drive " + Q.Drive$ + ": has "
  134.    S$ = STR$(Q.FreeSpace&)
  135.     GOSUB W.Commatize
  136.     S$ = SPACE$(11) + S$       ' Right justify
  137.     S$ = RIGHT$(S$, 11)
  138.    Lin$ = Lin$ + S$ + " bytes free ("
  139.    S$ = STR$(Q.FreePct&)
  140.     GOSUB W.Commatize
  141.     S$ = "   " + S$
  142.     S$ = RIGHT$(S$, 3)
  143.  
  144.   Lin$ = Lin$ + S$ + " %) " + CHR$(13) + CHR$(10)
  145.   BPrint(Lin$)
  146.  
  147.   Q.FreeSpace& = 0         ' Clean up in case next drive letter invalid
  148.   Q.FreePct& = 0
  149.   RETURN
  150.  '------
  151.  
  152.  
  153. W.Commatize:
  154.   '-----------------------------------------------------------------------
  155.   'Call with digital string in S$, returns S$ containing commas (longer!)
  156.   '-----------------------------------------------------------------------
  157.   S$ = LTRIM$(S$): S$ = SPACE$(12) + S$: S$ = RIGHT$(S$, 12)
  158.   S2$ = LEFT$(S$, 3) + "," + MID$(S$, 4, 3) + "," + MID$(S$, 7, 3)
  159.   S2$ = S2$ + "," + RIGHT$(S$, 3)           ' Now length is 15
  160.   FOR Temp% = 1 TO LEN(S2$)
  161.       C$ = MID$(S2$, Temp%, 1)              ' One char at a time.
  162.       Num% = INSTR("0123456789-", C$)       ' Look for numeric char
  163.       IF (Num% <> 0) THEN                   ' Drop until 1st one
  164.           S$ = RIGHT$(S2$, (16 - Temp%))    ' Then keep only numeric
  165.           EXIT FOR                          ' ...and quit loop
  166.       END IF
  167.   NEXT Temp%
  168. W.Commatize.Exit:
  169.   RETURN
  170.  '------
  171.  
  172.